home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / BUSINESS / BARCODE.LZH / BAR39.PAS < prev    next >
Pascal/Delphi Source File  |  1990-08-02  |  12KB  |  376 lines
  1. {The following program was modified for 24 pin printers by John Beckwith
  2.  on 7-29-90. Lines from the 9 pin version are left as comments.}
  3. program barcode; { Logmars (Code 39) barcode routines for Epson type printers
  4.                 by: Cliff Knight, 6 Janebar Circle, Plymouth, MA  02360
  5.                     (617) 888 7480, CIS ID# 71106,1153,  Version 08/05/87
  6.  
  7. modified by lon rolland on 7/12/88 for: 1) code 39 only 2) command line driven
  8. 3) to output four lines; a description, the barcode itself, its corresponding
  9. number, and finally a second description on the bottom.
  10. 4) compile under tp4 to be run from dbase 5) a back slash delimitor between
  11. the descriptor group and the code group, (note) I check up to a maximum of
  12. twelve parm strings on the command line input
  13.  
  14. example: bar39 maytag repairman #2\12345-67-89 A xx xx\Southern Route Area #1
  15. would produce a result of:
  16.  
  17.                 MAYTAG REPAIRMAN #2
  18.                 || ||| | |||| ||| ||| |
  19.                 || ||| | |||| ||| ||| |    (label stock is 1 1/2 by 4 inches)
  20.                 || ||| | |||| ||| ||| |
  21.                 12345-67-89 A XX XX
  22.                 SOUTHERN ROUTE AREA #1
  23.  
  24. this thing has been modified more than a dozen times. the most recent request
  25. came from paul mincone in the boston office. there has been a big chance in
  26. how the parm string is fetched and we added the fourth line. }
  27.  
  28. {$V-,D-,I-,R-,S-} { lets 'JUST SAY NO' to checking, lets turn it off }
  29.  
  30. uses Printer;
  31.  
  32. {NOTE: all types and variables with '' as 1st two chars
  33.        are globally required by the barcode routines}
  34.  
  35. const
  36.   slash = '\';
  37. type
  38.   Str5   =string[5];
  39.   Str10  =string[10];
  40.   Str80  =string[80];
  41.   StrMax =string[255];
  42.  
  43. var
  44.   BCArrary     :array[0..1000] of byte;
  45.   BCArraryLen  :integer;
  46.   GraphLen  :integer;
  47.   KWide     :integer;
  48.   KNarr     :integer;
  49.   Passes    :integer;
  50.   i         : byte;
  51.   found       :boolean;
  52.   line        :Str80;
  53.   spot          :integer;
  54.   Sequence      :Str80;
  55.   Desc1            :Str80;
  56.   Desc2            :Str80;
  57.   CType         :char;
  58.   Size          :integer;
  59.   Density       :integer;
  60.  
  61. {***** BarCode Routines *****}
  62.  
  63. function UpCaseStr (s :StrMax) :StrMax;
  64. var
  65.   j :integer;
  66. begin
  67.   for j:=1 to length(s) do
  68.     s[j]:=upcase(s[j]);
  69.   UpCaseStr:=s;
  70.   end;         {NOTE: both 'Init' & 'Print' routines use this function}
  71.  
  72. procedure PrintBarCode (ho,vs,ve,fl,ht :integer; sq,de1,de2 :Str80; vx :integer);
  73.  
  74. {          ho = horizontal offset in 120th's of an inch...
  75.            vs = vertical offset (+ or -) at start of barcode
  76.                 in 216th's of an inch...
  77.            ve = vertical offset (+ or -) at end of barcode
  78.                 in 216th's of an inch...
  79.                 NOTE: Set ve = -(ht-1)*23 to 'back-up'
  80.                 for "side-by-side" codes...
  81.            fl = barcode field length in 120th's of an inch
  82.                 barcode will be centered in this field,
  83.                 use fl=0 to print left, upper corner
  84.                 at (ho,vs)...
  85.            ht = number of graphics passes/barcode
  86.                   (1 pass = 23/216th's inch)...
  87.            sq = sequence string to be printed under barcode
  88.                   (set to '' if not wanted)
  89.            vx = vertical offset to align a new label
  90.            de1,de2 = description on top, description on bottom }
  91. var
  92.   f,h,i,j,k,l,m  :integer;
  93.   vc,gch         :char;
  94.  
  95.   procedure HorizGTab (n :integer);   {offset barcode left n/120"}
  96.   begin
  97.     write(lst,#27,'L',chr(lo(n)),chr(hi(n)));
  98.     while n > 0 do
  99.     begin
  100.       write(lst,#0);
  101.       n:=pred(n);
  102.     end;
  103.   end;         {HorizGTab}
  104.  
  105.   procedure VerticalGTab (n :integer);    {move paper +/- n/216"}
  106.   begin
  107.     if n <> 0 then begin
  108.       if n > 0 then
  109.         vc := 'J'
  110.       else
  111.         vc:='j';
  112.       write(lst,#27,vc,chr(abs(n)));
  113.       end;
  114.     end;
  115.  
  116.   procedure DoHorizTabs (x1,x2 :integer);
  117.   begin
  118.     if x1>0 then
  119.       HorizGTab(x1);
  120.     if x2>0 then
  121.       HorizGTab(x2);
  122.     end;
  123.  
  124.   procedure PrintHRI (s :Str80);    {print centered HRI}
  125.   begin
  126.     s:=UpCaseStr(s);
  127.     writeln(lst);   { this one advances the paper after the barcode }
  128.     write(lst,#14,#27,'G'); {set enlarged(14)/double strike mode}
  129.     write(lst,s,#20,#27,'H');   {reset enlarged(20)/double strike}
  130.     end;
  131.  
  132. begin
  133.   k:=(fl-GraphLen) div 2;
  134.   PrintHRI(de1);
  135.   VerticalGTab(vs);
  136.   for h:=1 to ht do
  137.   begin
  138.     for m:=1 to Passes do begin
  139.       write(lst,#13);
  140.       DoHorizTabs(ho,k);
  141. {old line:      write(lst,#27,'L',chr(lo(GraphLen)),chr(hi(GraphLen)));}
  142.       write(lst,#27,'*',#33,chr(lo(GraphLen)),chr(hi(GraphLen)));
  143.       f:=1;
  144.       for i:=1 to BCArraryLen do begin
  145.         f:=swap(f);
  146.         gch:=chr(hi(f)*$ff);
  147.         for j:=1 to BCArrary[i] do
  148. {old line:          write(lst,gch);}
  149.           write(lst,gch,gch,gch);
  150.         end;
  151.       write(lst,#13);
  152.       end;
  153.     if h<ht then
  154. {old line:      write(lst,#27,'J',#23);}
  155.       write(lst,#27,'J',#24);
  156.     end;
  157.   PrintHRI(sq);
  158.   PrintHRI(de2);
  159.   VerticalGTab(vx);
  160.   end;               {PrintBarCode}
  161.  
  162. {*************************************************************}
  163.  
  164. procedure InitBarCode (s :Str80; z,d :integer; t :char);
  165.  
  166. {           s = sequence to be encoded
  167.             z = size, number of columns in narrow bar
  168.             d = density, number of print head passes per graphic line
  169.             t = type, '3' = "3 of 9", '2' = "I 2 of 5"
  170. }
  171.  
  172.   procedure Fill39BCArrary (c :char);
  173.   var
  174.     s         :Str10;
  175.     e,h,i     :integer;
  176.   begin
  177.     c:=UpCase(c);
  178.     case c of
  179.       ' ' : s:='0110001000';
  180.       '$' : s:='0101010000';
  181.       '%' : s:='0001010100';
  182.       '*' : s:='0100101000';
  183.       '+' : s:='0100010100';
  184.       '-' : s:='0100001010';
  185.       '.' : s:='1100001000';
  186.       '/' : s:='0101000100';
  187.       '0' : s:='0001101000';
  188.       '1' : s:='1001000010';
  189.       '2' : s:='0011000010';
  190.       '3' : s:='1011000000';
  191.       '4' : s:='0001100010';
  192.       '5' : s:='1001100000';
  193.       '6' : s:='0011100000';
  194.       '7' : s:='0001001010';
  195.       '8' : s:='1001001000';
  196.       '9' : s:='0011001000';
  197.       'A' : s:='1000010010';
  198.       'B' : s:='0010010010';
  199.       'C' : s:='1010010000';
  200.       'D' : s:='0000110010';
  201.       'E' : s:='1000110000';
  202.       'F' : s:='0010110000';
  203.       'G' : s:='0000011010';
  204.       'H' : s:='1000011000';
  205.       'I' : s:='0010011000';
  206.       'J' : s:='0000111000';
  207.       'K' : s:='1000000110';
  208.       'L' : s:='0010000110';
  209.       'M' : s:='1010000100';
  210.       'N' : s:='0000100110';
  211.       'O' : s:='1000100100';
  212.       'P' : s:='0010100100';
  213.       'Q' : s:='0000001110';
  214.       'R' : s:='1000001100';
  215.       'S' : s:='0010001100';
  216.       'T' : s:='0000101100';
  217.       'U' : s:='1100000010';
  218.       'V' : s:='0110000010';
  219.       'W' : s:='1110000000';
  220.       'X' : s:='0100100010';
  221.       'Y' : s:='1100100000';
  222.       'Z' : s:='0110100000'
  223.     end;    {case}
  224.     for h:=1 to 10 do
  225.     begin
  226.       BCArraryLen:=succ(BCArraryLen);
  227.       BCArrary[BCArraryLen]:=(ord(s[h])-48)*KWide+KNarr;
  228.     end;
  229.   end;             {Fill39BCArrary}
  230.  
  231.   procedure ScanSequence (s :Str80; t :char);
  232.   var
  233.     h,i       :integer;
  234.     ws        :Str5;
  235.     es,os     :Str80;
  236.     is        :StrMax;
  237.   begin
  238.     BCArraryLen:=0;
  239.     s := '*' + s + '*';    {like the old one!!!}
  240.     i:=1;
  241.     es[0] := #0;
  242.     os[0] := #0;
  243.     for h:=1 to length(s) do
  244.       begin
  245.         Fill39BCArrary(s[h]);
  246.       end;        {for..to}
  247.   end;             {ScanSequence}
  248.  
  249.   procedure GetGraphLen;
  250.   var
  251.     f,j,i     :integer;
  252.   begin
  253.     f:=1;
  254.     GraphLen:=0;
  255.     for i:=1 to BCArraryLen do
  256.     begin
  257.       f:=swap(f);
  258.       for j:=1 to (BCArrary[i]+lo(f)) do
  259.         GraphLen:=succ(GraphLen);
  260.         BCArrary[i]:=BCArrary[i]+lo(f);
  261.     end;
  262.   end;             {GetGraphLen}
  263.  
  264. begin
  265.   KWide:=z*2;
  266.   KNarr:=z;
  267.   Passes:=d;
  268.   s:=UpCaseStr(s);
  269.   ScanSequence(s,t);
  270.   GetGraphLen;
  271. end;               {the end of InitBarCode}
  272.  
  273. {*************************************************************}
  274.  
  275. function find_delim(var str : Str80) : str80;
  276. begin
  277.   found := false;
  278.   spot := pos(slash,str);  { does this line have a back slash? }
  279.   if spot <> 0 then        { if we finally got it, then... }
  280.     begin
  281.       find_delim := copy(str,1,pred(spot));
  282.       delete(str,1,spot);
  283.       found := true;
  284.     end
  285.   else
  286.     find_delim := str; { pass back the whole thing }
  287. end;
  288.  
  289. {- - - - - - - - - - - M A I N - - - - - - - - - - -}
  290.  
  291. begin
  292.     CType:='3';  { code39 }
  293.     Size := 1;
  294.     Density := 1;
  295.     line[0] := #0;      { smarter, less code method }
  296.     Desc1[0] := #0;
  297.     Desc2[0] := #0;
  298.     Sequence := #0;
  299.     if paramcount > 0 then
  300.       begin
  301.         for i := 1 to paramcount do    { build to param string }
  302.           begin
  303.             line := line + paramstr(i) + ' ';
  304.           end;
  305.         Desc1    := find_delim(line);
  306.         if not found then            { check for error }
  307.           begin
  308.             writeln('ERROR, no delimitor (the back slash) ',
  309.                     'to show where the description ends');
  310.             writeln('and the barcode sequence begins.');
  311.           end;
  312.         Sequence := find_delim(line);
  313.         if not found then            { check for error }
  314.           begin
  315.             writeln('ERROR, no delimitor (the back slash) ',
  316.                     'to show where the barcode ends');
  317.             writeln('and the barcode sequence begins.');
  318.           end;
  319.         Desc2    := line;  { the remainder goes on the bottom line }
  320.         if found then
  321.           begin
  322.             writeln('top desc."',Desc1,'" barcode "',Sequence,
  323.             '" bot.desc."',Desc2,'" ');
  324.             write(lst,#13,#10);
  325. { following initializes barcode graphics array... }
  326.  
  327.             InitBarCode(Sequence,Size,Density,CType);
  328.  
  329. { this is the call to the 'PrintBarCode' procedure...
  330.   the passed parameters are as follows:
  331.               10 = 'ho'= horizontal offset for barcode (in 120ths/inch)
  332.               40 = 'vs'= vert. motion "before" printing code (in 216ths/inch)
  333. -((Size*2-1)*23) = 've'= vert. motion "after" printing code (in 216ths/inch)
  334.                    NOTE: The height 'ht' following is defined as 'Size*2'.
  335.                    therefore the paper will be advanced (Size*2-1)*23)/216ths
  336.                    of an inch in printing this bar.  Specifying a negative
  337.                    vertical motion after printing the code will move the
  338.                    paper backward and allow the second bar to be printed at
  339.                    the same vertical position on the paper.
  340.                0 = 'fl'= field width for centering of code (in 120ths/inch)
  341. was - - - -  Size*2 = 'ht'= the height of the barcode (in 23/216ths inch units)
  342. changed to size*3 for increasing the height of the barcode itself!!!
  343.         Desc1 =  a description of the item to print first
  344.              95 = 'vx' = vert. motion to align print to a new label }
  345.  
  346.             PrintBarCode(10,40,-((Size*2-1)*23),0,Size*3,
  347.                 Sequence,Desc1,Desc2,95);
  348.  
  349. { the number 95 is an alignment to advance the paper to the next label.
  350.   the labels in use are 101 mm wide and 38 mm (1 ½ inches) tall }
  351.           end;  { found = true }
  352.       end  { paramcount > 0 }
  353.     else
  354.       begin
  355.         writeln('I''m trying as hard as I can but you goofed up the input line again!');
  356.         writeln('Please type it in as: "bc39 1st description\barcode number\2nd description".');
  357.         writeln('The separator (or deliminator) is the simple back slash character.');
  358.         writeln('The first description will be the name across the top of the barcode label.');
  359.         writeln('Next comes the triple height, single pass barcode number (in CODE39).');
  360.         writeln('Third, is the barcode number again, but this time in text format.');
  361.         writeln('Fourth and finally comes the second description line for the bottom.');
  362.         writeln('Please note that CODE39 can use letters and numbers both. Lower case');
  363.         writeln('letters will be translated to uppercase letters. And finally spaces');
  364.         writeln('are allowed in both the description parts and barcode parts.');
  365.         writeln;
  366.         writeln('example: bar39 maytag repairman #2\12345-67-89 AB xx xx\Southern Route Area #1');
  367.         writeln('would produce a result of:');
  368.         writeln('           MAYTAG REPAIRMAN #2      ');
  369.         writeln('           || ||| | |||| ||| ||| || ');
  370.         writeln('           || ||| | |||| ||| ||| || ');
  371.         writeln('           || ||| | |||| ||| ||| || ');
  372.         writeln('           12345-67-89 AB XX XX    ');
  373.         writeln('           SOUTHERN ROUTE AREA #1   ');
  374.       end;
  375. end.
  376.